home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / HyperCard Related / XCMDs & XFCNs / ClipBoardToPictFile / ClipBoardToPictFile.p < prev    next >
Encoding:
Text File  |  1991-03-29  |  4.9 KB  |  193 lines  |  [TEXT/MPS ]
  1. {$R-}
  2. {$S ClipBoardToPictFile }
  3.  
  4. { 
  5.  
  6.     ClipBoardToPictFile(FileName, CreatorType)
  7.  
  8.      This HyperCard XFCN takes the PICT on the clipboard and turns it into
  9.     a PICT file with the given name.  It does not matter whether the PICT came
  10.     from the HyperCard paint tools, from another XCMD, or from another
  11.     application altogether.
  12.     
  13.     The optional parameter CreatorType is a four-character string
  14.     which will be the creator type of the file.  This will allow the file
  15.     to be double-clicked to invoke the corresponding application.  The 
  16.     default value is '????' -- which means no application.
  17.     
  18.     If it is successful, then empty is returned, otherwise the return value
  19.     is an error message.}
  20.  
  21. UNIT DummyUnit;
  22.  
  23. INTERFACE
  24.  
  25.     USES {* ToolIntf, PackIntf, *}
  26.             Menus, Events, TextEdit, HyperXCmd, 
  27.             OSIntf, Scrap, QuickDraw;
  28.  
  29.     PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  30.  
  31. IMPLEMENTATION
  32.  
  33.     PROCEDURE ClipBoardToPictFile(paramPtr: XCmdPtr);
  34.     FORWARD;
  35.  
  36.     PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  37.     BEGIN
  38.         ClipBoardToPictFile(paramPtr)
  39.     END { entrypoint } ;
  40.  
  41.  
  42.     PROCEDURE ClipBoardToPictFile(paramPtr: XCmdPtr);
  43.     
  44.     CONST
  45.     
  46.     MinParams =        1;
  47.     MaxParams =        2;
  48.  
  49.     PictHeaderSize = 512;
  50.     XFCNSignature = 'Created by ClipBoardToPictFile XFCN by Chris Thorman';
  51.     
  52.     TYPE
  53.     
  54.     ParamArray =        PACKED ARRAY [1..MaxParams] OF Str255;
  55.  
  56.     PictFileHeader     =    PACKED ARRAY [1..PictHeaderSize] OF CHAR;
  57.  
  58.  
  59.     VAR
  60.     
  61.     ParamStrings:            ParamArray;
  62.  
  63.     FileNameParam:            Str255;
  64.     CreatorTypeParam:        OSType;
  65.     
  66.     OutFileRefNum:            Integer;
  67.  
  68.     ThePict:                Handle;
  69.     PictSize:                LONGINT;
  70.     ScrapOffset:            LONGINT;
  71.     FileError:                Integer;
  72.     Success:                Boolean;
  73.     
  74.         PROCEDURE ExitWithMessage(aString:    Str255);
  75.         BEGIN
  76.             WITH paramPtr^ DO BEGIN
  77.                 returnValue := PasToZero(paramPtr, aString);
  78.                 EXIT(ClipBoardToPictFile);
  79.             END;
  80.         END;
  81.  
  82.         PROCEDURE ExitWithError(aString: Str255);
  83.         BEGIN
  84.             ExitWithMessage(concat('•••••••• Error: ', aString, '.'));
  85.         END;
  86.                         
  87.         FUNCTION WritePICTFile(ThePict: Handle; OutFileRefNum: Integer): Boolean;
  88.         VAR
  89.             Success:        Boolean;
  90.             FileHeader:        PictFileHeader; 
  91.             NumBytes:        LONGINT;
  92.             Signature:        Str255;
  93.             
  94.         BEGIN
  95.         
  96.             {* The file header contains nothing but a gratuitous signature *}
  97.             Signature :=    XFCNSignature;
  98.             
  99.             BlockMove(Ptr(ORD(@Signature) + 1), @FileHeader, length(Signature));
  100.             
  101.             NumBytes := PictHeaderSize;
  102.             Success := (FSWrite(OutFileRefNum, NumBytes, @FileHeader) = NoErr);
  103.             WritePICTFile := Success;
  104.             IF (NOT Success) THEN Exit(WritePICTFile);
  105.             
  106.             {* The rest of the file is just the PICT itself *}
  107.             NumBytes := GetHandleSize(ThePict);
  108.             Success := (FSWrite(OutFileRefNum, NumBytes, ThePict^) = NoErr);
  109.             WritePICTFile := Success;
  110.             IF (NOT Success) THEN Exit(WritePICTFile);
  111.         
  112.         END;
  113.             
  114.         PROCEDURE ParseParams;
  115.         VAR
  116.             ParamNum:            integer;
  117.         BEGIN
  118.             WITH paramPtr^ DO 
  119.             BEGIN
  120.                 IF (paramCount < MinParams) THEN ExitWithError('Too few parameters');
  121.                 IF (paramCount > MaxParams) THEN ExitWithError('Too many parameters');
  122.             
  123.                 ParamNum := 1; {* Required *}
  124.                 
  125.                 ZeroToPas(ParamPtr, Params[ParamNum]^, ParamStrings[ParamNum]);
  126.                 FileNameParam := ParamStrings[ParamNum];
  127.                 IF (FileNameParam = '') THEN ExitWithError('Empty file name');
  128.                 
  129.                 ParamNum := 2; {* Optional *}
  130.                 
  131.                 IF (paramCount >= ParamNum) THEN
  132.                     BEGIN
  133.                         ZeroToPas(paramPtr, params[ParamNum]^, ParamStrings[ParamNum]);  
  134.                         IF (length(ParamStrings[ParamNum]) <> 4)
  135.                         THEN ExitWithError(concat('Bad Creator Type: ', ParamStrings[ParamNum]));
  136.                         
  137.                         CreatorTypeParam[1] := ParamStrings[ParamNum][1];
  138.                         CreatorTypeParam[2] := ParamStrings[ParamNum][2];
  139.                         CreatorTypeParam[3] := ParamStrings[ParamNum][3];
  140.                         CreatorTypeParam[4] := ParamStrings[ParamNum][4];
  141.                     END
  142.                 ELSE
  143.                     BEGIN
  144.                         CreatorTypeParam := '????';
  145.                     END;    
  146.             END;
  147.         END;
  148.             
  149.     BEGIN {ClipBoardToPictFile}
  150.         
  151.         ParseParams;
  152.     
  153.         ThePict := NewHandle(0);
  154.         IF (ThePict = NIL) THEN ExitWithError('Couldn’t allocate zero-size handle');
  155.         
  156.         PictSize := GetScrap(ThePict, 'PICT', ScrapOffset);    
  157.         IF (PictSize = 0)
  158.         THEN 
  159.             BEGIN
  160.                 DisposHandle(ThePict);
  161.                 ExitWithError('Pict was of zero size');
  162.             END;
  163.         IF (PictSize < 0)
  164.         THEN 
  165.             BEGIN
  166.                 DisposHandle(ThePict);
  167.                 IF (PictSize = NoTypeErr) THEN ExitWithError('No data of type PICT on clipboard');
  168.                 ExitWithError('Unknown error in getting PICT');
  169.             END;
  170.     
  171.         IF (Create(FileNameParam, 0, CreatorTypeParam, 'PICT') <> NoErr)  
  172.         THEN ExitWithError(concat('Couldn’t create file: ', FileNameParam, '.  It may already exist'));
  173.  
  174.         IF (FSOpen(FileNameParam, 0, OutFileRefNum) <> NoErr)  
  175.         THEN ExitWithError(concat('Couldn’t open file: ', FileNameParam));
  176.  
  177.         Success := WritePICTFile(ThePict, OutFileRefNum);
  178.         
  179.         DisposHandle(ThePict);
  180.         FileError := FSClose(OutFileRefNum);
  181.         
  182.         IF (NOT Success) THEN ExitWithError(concat('Error Writing PICT to File: ', FileNameParam));
  183.         IF (FileError <> NoErr) THEN ExitWithError('Error closing file');
  184.         
  185.         ExitWithMessage('');
  186.         
  187.  
  188.     END { ClipBoardToPictFile } ;
  189.  
  190. END. { DummyUnit }
  191.  
  192.  
  193.